home *** CD-ROM | disk | FTP | other *** search
/ Shareware Grab Bag / Shareware Grab Bag.iso / 001 / pibt40s1.arc / GETSCRIP.MOD < prev    next >
Text File  |  1987-07-29  |  38KB  |  995 lines
  1. (*----------------------------------------------------------------------*)
  2. (*        Get_Script_Command --- Get command from script buffer         *)
  3. (*----------------------------------------------------------------------*)
  4.  
  5. PROCEDURE Get_Script_Command( VAR Command : PibTerm_Command_Type );
  6.  
  7. (*----------------------------------------------------------------------*)
  8. (*                                                                      *)
  9. (*       Procedure:   Get_Script_Command                                *)
  10. (*                                                                      *)
  11. (*       Purpose:     Get command from script buffer                    *)
  12. (*                                                                      *)
  13. (*       Calling Sequence:                                              *)
  14. (*                                                                      *)
  15. (*          Get_Script_Command( VAR Command : PibTerm_Command_Type );   *)
  16. (*                                                                      *)
  17. (*             Command --- command extracted from buffer                *)
  18. (*                                                                      *)
  19. (*----------------------------------------------------------------------*)
  20.  
  21. VAR
  22.    I          : INTEGER;
  23.    L          : INTEGER;
  24.    Ch         : CHAR;
  25.    IBogus     : INTEGER;
  26.    Key_Offset : INTEGER;
  27.    Section_No : INTEGER;
  28.    IVal       : INTEGER;
  29.    VPtrs      : Script_Variable_List_Ptr;
  30.  
  31. LABEL
  32.    LDelaySy,    LSuspendSy,   LQuitSy,     LChdirSy,     LDosSy,   LKeySy,
  33.    LMessageSy,  LRedialSy,    LSTextSy,    LTextSy,      LTranslateSy,
  34.    LWaitSy,     LWriteLogSy,  LDialSy,     LExecuteSy,   LExeNewSy,
  35.    LFileSy,     LRInputSy,    LGoToXYSy,   LPImportSy,   LImportSy,
  36.    LDeclareSy,  LIfOKSy,      LIfOpSy,     LIfConSy,     LIfDialSy,
  37.    LIfFoundSy,  LIfRemStrSy,  LIfExistsSy, LIfLocStrSy,  LKeySendSy,
  38.    LKeyDefSy,   LScriptSy,    LSetSy,      LCallSy,      LGoToSy,
  39.    LWaitStrSy,  LCaptureSy,   LWhenSy,     LInputSy,     LReceiveSy,
  40.    LSendSy,     LCloseSy,     LOpenSy,     LReadSy,      LReadLnSy,
  41.    LWriteSy,    LWriteLnSy,   LWhereXYSy,  LWaitCountSy, LWaitQuietSy,
  42.    LWaitTimeSy, LWaitListSy,  LWhenDropSy, LZapVarSy,    LMenuSy,
  43.    LGetVarSy,   LSetVarSy,    LGetDirSy,   LEndCase;
  44.  
  45. (*----------------------------------------------------------------------*)
  46. (*   Copy_Script_String --- Copy a string from the script buffer        *)
  47. (*----------------------------------------------------------------------*)
  48.  
  49. PROCEDURE Copy_Script_String( VAR S: AnyStr; VAR V: INTEGER );
  50.  
  51. (*----------------------------------------------------------------------*)
  52. (*                                                                      *)
  53. (*     Remarks:                                                         *)
  54. (*                                                                      *)
  55. (*        Each string is stored in the form:                            *)
  56. (*                                                                      *)
  57. (*           String_Type    1 byte                                      *)
  58. (*           String_Length  1 byte                                      *)
  59. (*           Text           String_Length bytes                         *)
  60. (*                                                                      *)
  61. (*       The values for String_Type are:                                *)
  62. (*                                                                      *)
  63. (*           0  --- ordinary string, text follows                       *)
  64. (*           1  --- use 'localreply' text                               *)
  65. (*           2  --- use 'remotereply' text                              *)
  66. (*           3  --- use 'set' variable -- String_length is index        *)
  67. (*                                                                      *)
  68. (*       String_Length and Text are stored when String_Type = 0.        *)
  69. (*       Neither is stored for types 1 and 2.  String_Length =          *)
  70. (*       variable index is stored for type 3.                           *)
  71. (*                                                                      *)
  72. (*----------------------------------------------------------------------*)
  73.  
  74. VAR
  75.    L: INTEGER;
  76.  
  77. BEGIN (* Copy_Script_String *)
  78.                                    (* Pick up string type *)
  79.  
  80.    Script_Buffer_Pos := SUCC( Script_Buffer_Pos );
  81.    V                 := Script_Buffer^[Script_Buffer_Pos];
  82.  
  83.                                    (* Get string value based upon type *)
  84.    CASE V OF
  85.  
  86.       0:  BEGIN (* Text string *)
  87.  
  88.              Script_Buffer_Pos := SUCC( Script_Buffer_Pos );
  89.  
  90.              L := Script_Buffer^[Script_Buffer_Pos];
  91.  
  92.              MOVE( Script_Buffer^[Script_Buffer_Pos + 1], S[1], L );
  93.  
  94.              S[0] := CHR( L );
  95.  
  96.              Script_Buffer_Pos := Script_Buffer_Pos + L;
  97. {
  98.              IF Debug_Mode THEN
  99.                 WRITELN('---> String length = ',L,', string = <',S,'>');
  100. }
  101.           END;
  102.  
  103.       1:  BEGIN (* Local reply string *)
  104.              S := Script_Reply;
  105.           END;
  106.  
  107.       2:  BEGIN (* Remote reply string *)
  108.              S := Script_Remote_Reply;
  109.           END;
  110.  
  111.       3:  BEGIN (* Script variable *)
  112.              Script_Buffer_Pos := SUCC( Script_Buffer_Pos );
  113.              V                 := Script_Buffer^[Script_Buffer_Pos];
  114.              S                 := Script_Variables^[V].Var_Value^;
  115. {
  116.              IF Debug_Mode THEN
  117.                 WRITELN('---> Script variable ',V,' has value <',S,'>');
  118. }
  119.           END   (* Script variable *);
  120.  
  121.       ELSE
  122.           S[0] := #0;
  123.           V    := 4;
  124. {
  125.           IF Debug_Mode THEN
  126.              WRITELN('---> BOGUS STRING MODE = ',V,' in Copy_Script_String.');
  127. }
  128.    END (* CASE *);
  129.  
  130. END   (* Copy_Script_String *);
  131.  
  132. (*----------------------------------------------------------------------*)
  133. (*   Copy_Script_Integer --- Copy an integer from the script buffer     *)
  134. (*----------------------------------------------------------------------*)
  135.  
  136. PROCEDURE Copy_Script_Integer( VAR IntVal: INTEGER;
  137.                                VAR V     : INTEGER );
  138.  
  139. (*----------------------------------------------------------------------*)
  140. (*                                                                      *)
  141. (*     Remarks:                                                         *)
  142. (*                                                                      *)
  143. (*        Each integer is stored in the form:                           *)
  144. (*                                                                      *)
  145. (*           Integer_Type    1 byte                                     *)
  146. (*           Integer_Value   2 bytes (if Integer_Type=0)                *)
  147. (*                                                                      *)
  148. (*       The values for String_Type are:                                *)
  149. (*                                                                      *)
  150. (*           0  --- integer constant (two bytes) follows                *)
  151. (*           n  --- use variable "n"                                    *)
  152. (*                                                                      *)
  153. (*----------------------------------------------------------------------*)
  154.  
  155. VAR
  156.    Int_Bytes : ARRAY[1..2] OF BYTE ABSOLUTE IntVal;
  157.  
  158. BEGIN (* Copy_Script_Integer *)
  159.  
  160.    Script_Buffer_Pos := SUCC( Script_Buffer_Pos );
  161.    V                 := Script_Buffer^[Script_Buffer_Pos];
  162.  
  163.    IF ( V = 0 ) THEN
  164.       BEGIN
  165.          Int_Bytes[1] := Script_Buffer^[Script_Buffer_Pos + 1 ];
  166.          Int_Bytes[2] := Script_Buffer^[Script_Buffer_Pos + 2 ];
  167.          Script_Buffer_Pos := Script_Buffer_Pos + 2;
  168.       END
  169.    ELSE
  170.       BEGIN
  171.          Int_Bytes[1] := ORD( Script_Variables^[V].Var_Value^[1] );
  172.          Int_Bytes[2] := ORD( Script_Variables^[V].Var_Value^[2] );
  173.       END;
  174.  
  175. END   (* Copy_Script_Integer *);
  176.  
  177. (*----------------------------------------------------------------------*)
  178. (*   Copy_Script_Integer_Constant --- Copy integer cosntant from script *)
  179. (*----------------------------------------------------------------------*)
  180.  
  181. PROCEDURE Copy_Script_Integer_Constant( VAR IntVal: INTEGER );
  182.  
  183. VAR
  184.    Int_Bytes : ARRAY[1..2] OF BYTE ABSOLUTE IntVal;
  185.  
  186. BEGIN (* Copy_Script_Integer_Constant *)
  187.  
  188.    Int_Bytes[1]      := Script_Buffer^[Script_Buffer_Pos + 1 ];
  189.    Int_Bytes[2]      := Script_Buffer^[Script_Buffer_Pos + 2 ];
  190.    Script_Buffer_Pos := Script_Buffer_Pos + 2;
  191.  
  192. END   (* Copy_Script_Integer_Constant *);
  193.  
  194. (*----------------------------------------------------------------------*)
  195. (*   Get_Transfer_Protocol --- Get file transfer protocol               *)
  196. (*----------------------------------------------------------------------*)
  197.  
  198. PROCEDURE Get_Transfer_Protocol;
  199.  
  200. VAR
  201.    I     : INTEGER;
  202.    Found : BOOLEAN;
  203.    TName : Char_2;
  204.    TType : Transfer_Type;
  205.  
  206. BEGIN (* Get_Transfer_Protocol *)
  207.  
  208.    Found := FALSE;
  209.                                    (* Pick up transfer type name *)
  210.    TName := '  ';
  211.    TType := None;
  212.  
  213.    FOR I := 1 TO MIN( 2 , LENGTH( Script_String_2 ) ) DO
  214.       TName[I] := UpCase( Script_String_2[I] );
  215.  
  216.                                    (* Look up transfer name *)
  217.  
  218.    FOR I := 1 TO ( Max_Transfer_Types - 1 ) DO
  219.       IF ( TName = Trans_Type_Name[Transfers[I]] ) THEN
  220.          BEGIN
  221.             TType := Transfers[I];
  222.             Found := TRUE;
  223.          END;
  224.                                    (* Didn't find it -- check special *)
  225.                                    (* Kermit names.                   *)
  226.    IF ( NOT Found ) THEN
  227.       IF ( TName = 'K ' ) THEN
  228.          TType := Kermit
  229.       ELSE IF ( TName = 'KA' ) THEN
  230.          BEGIN
  231.             TType := Kermit;
  232.             Kermit_File_Type_Var := Kermit_Ascii;
  233.          END
  234.       ELSE IF ( TName = 'KB' ) THEN
  235.          BEGIN
  236.             TType := Kermit;
  237.             Kermit_File_Type_Var := Kermit_Binary;
  238.          END;
  239.                                    (* Assume default type if none given *)
  240.    IF ( TType = None ) THEN
  241.       TType := Default_Transfer_Type;
  242.  
  243.                                    (* Record transfer type *)
  244.  
  245.    Script_Integer_1 := ORD( TType ) + 1;
  246.  
  247. END   (* Get_Transfer_Protocol *);
  248.  
  249. (*----------------------------------------------------------------------*)
  250. (*          Fix_Wait_Time --- Fix up time to wait for WAIT* commands    *)
  251. (*----------------------------------------------------------------------*)
  252.  
  253. PROCEDURE Fix_Wait_Time;
  254.  
  255. BEGIN (* Fix_Wait_Time *)
  256.  
  257.    IF ( Script_Wait_Time <= 0 ) THEN
  258.       Script_Wait_Time := Script_Default_Wait_Time;
  259.  
  260.    IF ( Script_Wait_Time <= 0 ) THEN
  261.       Script_Wait_Time := 30;
  262.  
  263.    Really_Wait_String := TRUE;
  264.  
  265.    Script_Wait_Start  := TimeOfDay;
  266.    Script_Wait_Found  := FALSE;
  267.  
  268.    Command            := Null_Command;
  269.  
  270. END   (* Fix_Wait_Time *);
  271.  
  272. (*----------------------------------------------------------------------*)
  273. (*          Get_WaitList --- Get stuff for WaitList command execution   *)
  274. (*----------------------------------------------------------------------*)
  275.  
  276. PROCEDURE Get_WaitList;
  277.  
  278. BEGIN (* Get_WaitList *)
  279.                                    (* Get result variable index *)
  280.  
  281.    Copy_Script_Integer( IBogus , Script_Wait_Result_Index );
  282.  
  283.                                    (* Zero out result index *)
  284.  
  285.    Script_Variables^[Script_Wait_Result_Index].Var_Value^ := CHR( 0 ) + CHR( 0 );
  286.  
  287.                                    (* Get # of strings *)
  288.  
  289.    Script_Buffer_Pos        := SUCC( Script_Buffer_Pos );
  290.    Script_Wait_Count        := Script_Buffer^[Script_Buffer_Pos];
  291.    Script_Wait_Check_Length := 0;
  292.  
  293.                                    (* Set up vector of wait strings *)
  294.  
  295.    FOR I := 1 TO Script_Wait_Count DO
  296.       WITH Script_Wait_List[I] DO
  297.          BEGIN
  298.             NEW( Wait_Text );
  299.             Copy_Script_String( Wait_Text^ , IBogus );
  300.             Wait_Text^ := Read_Ctrls( Wait_Text^ );
  301.             NEW( Wait_Reply );
  302.             Wait_Reply^[0] := #0;
  303.             Script_Wait_Check_Length := MAX( Script_Wait_Check_Length ,
  304.                                              LENGTH( Wait_Text^ ) );
  305.          END;
  306.  
  307.    Copy_Script_Integer_Constant( Script_Wait_Failure );
  308.  
  309.    WaitString_Mode := ( ( Script_Wait_Count > 0 ) AND
  310.                         ( Script_Wait_Check_Length > 0 ) );
  311.  
  312.                                    (* Get wait time *)
  313.  
  314.    Script_Wait_Time := Script_Default_Wait_Time;
  315.  
  316.    Fix_Wait_Time;
  317.  
  318. END   (* Get_WaitList *);
  319.  
  320. (*----------------------------------------------------------------------*)
  321. (*     Get_WaitString --- Get stuff for WaitString command execution    *)
  322. (*----------------------------------------------------------------------*)
  323.  
  324. PROCEDURE Get_WaitString;
  325.  
  326. BEGIN (* Get_WaitString *)
  327.  
  328.    Copy_Script_String ( Script_String    , IBogus );
  329.    Copy_Script_String ( Script_String_2  , IBogus );
  330.    Copy_Script_Integer( Script_Wait_Time , IBogus );
  331.  
  332.                                    (* No result index *)
  333.    Script_Wait_Result_Index := 0;
  334.  
  335.                                    (* If waitstring null, skip this guy *)
  336.  
  337.    IF ( LENGTH( Script_String ) = 0 ) THEN
  338.       BEGIN
  339.          WaitString_Mode   := FALSE;
  340.          Script_Wait_Count := 0;
  341.       END
  342.    ELSE
  343.       BEGIN
  344.                                    (* One waitstring *)
  345.          Script_Wait_Count := 1;
  346.          WaitString_Mode   := TRUE;
  347.  
  348.          WITH Script_Wait_List[1] DO
  349.             BEGIN
  350.                NEW( Wait_Text );
  351.                Wait_Text^ := Read_Ctrls( Script_String );
  352.                NEW( Wait_Reply );
  353.                Wait_Reply^ := Read_Ctrls( Script_String_2 );
  354.                Script_Wait_Check_Length := LENGTH( Script_String );
  355.             END;
  356.  
  357.                                    (* Fix up wait time *)
  358.          Fix_Wait_Time;
  359.  
  360.       END;
  361.  
  362.    Copy_Script_Integer_Constant( Script_Wait_Failure );
  363.  
  364. END   (* Get_WaitString *);
  365.  
  366. (*----------------------------------------------------------------------*)
  367. (*                Get_Menu --- Get stuff for MENU command               *)
  368. (*----------------------------------------------------------------------*)
  369.  
  370. PROCEDURE Get_Menu;
  371.  
  372. VAR
  373.    Default : INTEGER;
  374.    Row     : INTEGER;
  375.    Col     : INTEGER;
  376.    NItems  : INTEGER;
  377.    Items   : INTEGER;
  378.  
  379. BEGIN (* Get_Menu *)
  380.                                    (* Result variable index *)
  381.  
  382.    Copy_Script_Integer( IBogus , Script_Integer_1 );
  383.  
  384.                                    (* Display position *)
  385.  
  386.    Copy_Script_Integer( Col    , IBogus );
  387.    Copy_Script_Integer( Row    , IBogus );
  388.  
  389.                                    (* Default *)
  390.  
  391.    Copy_Script_Integer( Default , IBogus );
  392.  
  393.                                    (* Get menu title *)
  394.  
  395.    Copy_Script_String( Script_String , IBogus );
  396.  
  397.                                    (* Get # of items *)
  398.  
  399.    Script_Buffer_Pos := SUCC( Script_Buffer_Pos );
  400.    NItems            := Script_Buffer^[Script_Buffer_Pos];
  401.  
  402.                                    (* Generate the menu *)
  403.  
  404.    NEW( Script_Menu_Holder );
  405.  
  406.    Make_A_Menu( Script_Menu_Holder^, NItems, Row, Col, 0, 0, Default,
  407.                 Script_String, '', FALSE );
  408.  
  409.                                    (* Get and store item strings *)
  410.    FOR Items := 1 TO NItems DO
  411.       Copy_Script_String( Script_Menu_Holder^.Menu_Entries[Items].Menu_Item_Text ,
  412.                           IBogus );
  413.  
  414. END   (* Get_Menu *);
  415.  
  416. (*----------------------------------------------------------------------*)
  417. (*                Locate_Var --- Locate variable                        *)
  418. (*----------------------------------------------------------------------*)
  419.  
  420. FUNCTION Locate_Var(     VPtrs  : Script_Variable_List_Ptr;
  421.                          VCount : INTEGER;
  422.                          VName  : AnyStr;
  423.                      VAR VType  : ShortStr;
  424.                      VAR Value  : AnyStr     ) : INTEGER;
  425.  
  426. VAR
  427.    I    : INTEGER;
  428.    IVal : INTEGER;
  429.  
  430. BEGIN (* Locate_Var *)
  431.  
  432.    VType      := 'UNDEFINED';
  433.    Value[0]   := #0;
  434.    Locate_Var := 0;
  435.    VName      := UpperCase( VName );
  436.  
  437.    FOR I := VCount DOWNTO 2 DO
  438.       IF ( VName = VPtrs^[I].Var_Name ) THEN
  439.          BEGIN
  440.             CASE VPtrs^[I].Var_Type OF
  441.                Integer_Variable_Type : BEGIN
  442.                                           VType := 'INTEGER';
  443.                                           MOVE( VPtrs^[I].Var_Value^[1], IVal, 2 );
  444.                                           STR( IVal , Value );
  445.                                        END;
  446.                String_Variable_Type  : BEGIN
  447.                                           VType := 'STRING';
  448.                                           Value := VPtrs^[I].Var_Value^;
  449.                                        END;
  450.             END (* CASE *);
  451.             Locate_Var := I;
  452.             EXIT;
  453.          END;
  454.  
  455. END   (* Locate_Var *);
  456.  
  457. (*----------------------------------------------------------------------*)
  458.  
  459. BEGIN (* Get_Script_Command *)
  460.                                    (* Check for suspended script      *)
  461.                                    (* and exit if suspension still    *)
  462.                                    (* in progress.                    *)
  463.  
  464.    IF ( Script_Suspend_Time > 0.0 ) THEN
  465.       IF ( TimeDiffH( Script_Suspend_Start, TimeOfDayH ) >
  466.          Script_Suspend_Time ) THEN
  467.             BEGIN
  468.                Command := Null_Command;
  469.                EXIT;
  470.             END
  471.       ELSE
  472.          Script_Suspend_Time := 0.0;
  473.  
  474.                                    (* Set script strings to null      *)
  475.    Script_String   [0] := #0;
  476.    Script_String_2 [0] := #0;
  477.    Script_Integer_1    := 0;
  478.                                    (* Point to next command in buffer *)
  479.  
  480.    Script_Buffer_Pos := SUCC( Script_Buffer_Pos );
  481.  
  482.                                    (* Pick up command type            *)
  483.  
  484.    Command   := PibTerm_Command_Table_2[ Script_Buffer^[Script_Buffer_Pos] ];
  485.  
  486.                                    (* For commands with arguments,     *)
  487.                                    (* get the arguments.               *)
  488. {
  489.    CASE Command Of
  490. }
  491.                                    (* Use jump table to avoid time-consuming *)
  492.                                    (* CASE statement.                        *)
  493.    I := ORD( Command );
  494.  
  495.    INLINE(
  496.      $8B/$9E/>I             {  MOV     BX,[BP+>I]         ;Pick up ORD(Command)}
  497.      /$89/$D8               {  MOV     AX,BX              ;Command}
  498.      /$D1/$E3               {  SHL     BX,1               ;Command * 2}
  499.      /$01/$C3               {  ADD     BX,AX              ;Command * 3}
  500.      /$B8/>*+6              {  MOV     AX,>*+6            ;Address of first GOTO}
  501.      /$01/$C3               {  ADD     BX,AX              ;Add offset of command}
  502.      /$FF/$E3               {  JMP     BX                 ;Branch to proper GOTO}
  503.    );
  504.       GOTO LEndCase;
  505.       GOTO LEndCase;
  506.       GOTO LEndCase;
  507.       GOTO LEndCase;
  508.       GOTO LEndCase;
  509.       GOTO LCallSy;
  510.       GOTO LCaptureSy;
  511.       GOTO LEndCase;
  512.       GOTO LChDirSy;
  513.       GOTO LEndCase;
  514.       GOTO LCloseSy;
  515.       GOTO LEndCase;
  516.       GOTO LEndCase;
  517.       GOTO LDeclareSy;
  518.       GOTO LDelaySy;
  519.       GOTO LEndCase;
  520.       GOTO LDialSy;
  521.       GOTO LEndCase;
  522.       GOTO LDosSy;
  523.       GOTO LEndCase;
  524.       GOTO LEndCase;
  525.       GOTO LEndCase;
  526.       GOTO LEndCase;
  527.       GOTO LEndCase;
  528.       GOTO LEndCase;
  529.       GOTO LEndCase;
  530.       GOTO LEndCase;
  531.       GOTO LEndCase;
  532.       GOTO LEndCase;
  533.       GOTO LExecuteSy;
  534.       GOTO LExeNewSy;
  535.       GOTO LEndCase;
  536.       GOTO LEndCase;
  537.       GOTO LEndCase;
  538.       GOTO LFileSy;
  539.       GOTO LEndCase;
  540.       GOTO LGetDirSy;
  541.       GOTO LEndCase;
  542.       GOTO LGetVarSy;
  543.       GOTO LEndCase;
  544.       GOTO LGoToSy;
  545.       GOTO LGoToXYSy;
  546.       GOTO LEndCase;
  547.       GOTO LEndCase;
  548.       GOTO LIfConSy;
  549.       GOTO LIfDialSy;
  550.       GOTO LEndCase;
  551.       GOTO LIfExistsSy;
  552.       GOTO LIfFoundSy;
  553.       GOTO LIfLocStrSy;
  554.       GOTO LIfOkSy;
  555.       GOTO LIfOpSy;
  556.       GOTO LIfRemStrSy;
  557.       GOTO LImportSy;
  558.       GOTO LEndCase;
  559.       GOTO LInputSy;
  560.       GOTO LEndCase;
  561.       GOTO LKeyDefSy;
  562.       GOTO LEndCase;
  563.       GOTO LKeySendSy;
  564.       GOTO LKeySy;
  565.       GOTO LEndCase;
  566.       GOTO LEndCase;
  567.       GOTO LMenuSy;
  568.       GOTO LMessageSy;
  569.       GOTO LEndCase;
  570.       GOTO LOpenSy;
  571.       GOTO LEndCase;
  572.       GOTO LPImportSy;
  573.       GOTO LEndCase;
  574.       GOTO LQuitSy;
  575.       GOTO LReadSy;
  576.       GOTO LReadLnSy;
  577.       GOTO LReceiveSy;
  578.       GOTO LReDialSy;
  579.       GOTO LEndCase;
  580.       GOTO LEndCase;
  581.       GOTO LEndCase;
  582.       GOTO LRInputSy;
  583.       GOTO LScriptSy;
  584.       GOTO LEndCase;
  585.       GOTO LSendSy;
  586.       GOTO LSetSy;
  587.       GOTO LEndCase;
  588.       GOTO LSetVarSy;
  589.       GOTO LSTextSy;
  590.       GOTO LSuspendSy;
  591.       GOTO LTextSy;
  592.       GOTO LEndCase;
  593.       GOTO LTranslateSy;
  594.       GOTO LEndCase;
  595.       GOTO LEndCase;
  596.       GOTO LWaitSy;
  597.       GOTO LWaitCountSy;
  598.       GOTO LWaitListSy;
  599.       GOTO LWaitQuietSy;
  600.       GOTO LWaitStrSy;
  601.       GOTO LWaitTimeSy;
  602.       GOTO LWhenSy;
  603.       GOTO LWhenDropSy;
  604.       GOTO LEndCase;
  605.       GOTO LWhereXYSy;
  606.       GOTO LEndCase;
  607.       GOTO LWriteSy;
  608.       GOTO LWriteLnSy;
  609.       GOTO LWriteLogSy;
  610.       GOTO LZapVarSy;
  611.       GOTO LEndCase;
  612.       GOTO LEndCase;
  613.  
  614.       LDelaySy    : BEGIN
  615.                        Copy_Script_Integer( Script_Integer_1 , IBogus );
  616.                        Delay_Time := Script_Integer_1 * 100;
  617.                     END;
  618.                     GOTO LEndCase;
  619.  
  620.       LSuspendSy  : BEGIN
  621.                        Copy_Script_Integer( Script_Integer_1 , IBogus );
  622.                        Script_Suspend_Time  := Script_Integer_1;
  623.                        Script_Suspend_Time  := Script_Suspend_Time * 10.0;
  624.                        Script_Suspend_Start := TimeOfDayH;
  625.                        Command              := Null_Command;
  626.                     END;
  627.                     GOTO LEndCase;
  628.  
  629.       LQuitSy     : Copy_Script_Integer_Constant( Script_Integer_1 );
  630.                     GOTO LEndCase;
  631.  
  632.       LChdirSy    : BEGIN
  633.                        Copy_Script_String( Script_String , IBogus );
  634.                        IVal := POS( ':' , Script_String );
  635.                        IF ( IVal > 0 ) THEN
  636.                           BEGIN
  637.                              Script_String_2 := Script_String[1];
  638.                              Script_String   := Substr( Script_String,
  639.                                                         SUCC( IVal ),
  640.                                                         255 );
  641.                           END
  642.                        ELSE
  643.                           Script_String_2 := Dir_Get_Default_Drive;
  644.                     END;
  645.                     GOTO LEndCase;
  646.  
  647.       LDosSy      :
  648.       LKeySy      :
  649.       LMessageSy  :
  650.       LRedialSy   :
  651.       LSTextSy    :
  652.       LTextSy     :
  653.       LTranslateSy:
  654.       LWaitSy     :
  655.       LWriteLogSy : Copy_Script_String( Script_String , IBogus );
  656.                     GOTO LEndCase;
  657.  
  658.       LDialSy     : BEGIN
  659.                        Copy_Script_String          ( Script_String , IBogus );
  660.                        Copy_Script_Integer_Constant( Script_Integer_1 );
  661.                     END;
  662.                     GOTO LEndCase;
  663.  
  664.       LExecuteSy  : BEGIN
  665.                        Copy_Script_String( Script_String_2 , IBogus );
  666.                        Script_Buffer_Pos := SUCC( Script_Buffer_Pos );
  667.                        Script_Parameter_Count := Script_Buffer^[Script_Buffer_Pos];
  668.                        IF( Script_Parameter_Count > 0 ) THEN
  669.                           BEGIN
  670.                              NEW( Script_Parameters );
  671.                              FOR I := 1 TO Script_Parameter_Count DO
  672.                                 BEGIN
  673.                                    Script_Buffer_Pos     := SUCC( Script_Buffer_Pos );
  674.                                    Script_Parameters^[I] :=
  675.                                       Script_Buffer^[Script_Buffer_Pos];
  676.                                 END;
  677.                           END
  678.                        ELSE
  679.                           Script_Parameters := NIL;
  680.                        Script_String := 'E';
  681.                     END;
  682.                     GOTO LEndCase;
  683.  
  684.       LExeNewSy   : BEGIN
  685.                        Copy_Script_String( Script_String_2 , IBogus );
  686.                        Copy_Script_String( Script_String   , IBogus );
  687.                        Script_String := Script_String + CHR( CR );
  688.                        MOVE( Script_String[0], Mem[CSeg:$80],
  689.                              ORD( Script_String[0] ) );
  690.                        Script_String := 'E';
  691.                     END;
  692.                     GOTO LEndCase;
  693.  
  694.       LFileSy     : BEGIN
  695.                        Copy_Script_Integer( Script_Integer_1 , IBogus );
  696.                        Copy_Script_String ( Script_String    , IBogus );
  697.                        Copy_Script_String ( Script_String_2  , IBogus );
  698.                     END;
  699.                     GOTO LEndCase;
  700.  
  701.       LRInputSy   : BEGIN
  702.                        Copy_Script_String          ( Script_String , IBogus );
  703.                        Copy_Script_Integer_Constant( Script_Integer_1 );
  704.                        Copy_Script_String          ( Script_String_2 ,
  705.                                                      Script_Integer_2 );
  706.                     END;
  707.                     GOTO LEndCase;
  708.  
  709.       LGoToXYSy   : BEGIN
  710.                        Copy_Script_Integer( Script_Integer_1 , IBogus );
  711.                        Copy_Script_Integer( Script_Integer_2 , IBogus );
  712.                     END;
  713.                     GOTO LEndCase;
  714.  
  715.       LPImportSy  :
  716.       LImportSy   :
  717.       LDeclareSy  : BEGIN
  718.                        Copy_Script_String          ( Script_String   , IBogus );
  719.                        Copy_Script_Integer_Constant( Script_Integer_1 );
  720.                        Copy_Script_Integer_Constant( Script_Integer_2 );
  721.                        Copy_Script_String          ( Script_String_2 , IBogus );
  722.                     END;
  723.                     GOTO LEndCase;
  724.  
  725.       LIfOKSy     :
  726.       LIfOpSy     :
  727.       LIfConSy    :
  728.       LIfDialSy   :
  729.       LIfFoundSy  : BEGIN
  730.                        Copy_Script_Integer_Constant( Script_Integer_1 );
  731.                        Copy_Script_Integer_Constant( Script_Integer_2 );
  732.                        Copy_Script_Integer_Constant( Script_Integer_3 );
  733.                     END;
  734.                     GOTO LEndCase;
  735.  
  736.       LIfRemStrSy :
  737.       LIfExistsSy :
  738.       LIfLocStrSy : BEGIN
  739.                        Copy_Script_Integer_Constant( Script_Integer_1 );
  740.                        Copy_Script_Integer_Constant( Script_Integer_2 );
  741.                        Copy_Script_Integer_Constant( Script_Integer_3 );
  742.                        Copy_Script_String ( Script_String , IBogus );
  743.                     END;
  744.                     GOTO LEndCase;
  745.  
  746.       LKeySendSy  : BEGIN
  747.                        Copy_Script_String( Script_String , IBogus );
  748.                        Get_Key_Section( Script_String, Key_Offset, Key_No, Section_No );
  749.                     END;
  750.                     GOTO LEndCase;
  751.  
  752.       LKeyDefSy   : BEGIN
  753.                        Copy_Script_String( Script_String   , IBogus );
  754.                        Copy_Script_String( Script_String_2 , IBogus );
  755.                     END;
  756.                     GOTO LEndCase;
  757.  
  758.       LScriptSy   : BEGIN
  759.                        Script_Buffer_Pos := SUCC( Script_Buffer_Pos );
  760.                        Script_String     := CHR( Script_Buffer^[Script_Buffer_Pos] );
  761.                        Copy_Script_String( Script_String_2 , IBogus );
  762.                     END;
  763.                     GOTO LEndCase;
  764.  
  765.       LSetSy      : BEGIN
  766.                        Copy_Script_Integer_Constant( Script_Integer_1 );
  767.                     END;
  768.                     GOTO LEndCase;
  769.  
  770.       LCallSy     : BEGIN
  771.  
  772.                        Script_Call_Depth := SUCC( Script_Call_Depth );
  773.  
  774.                        WITH Script_Call_Stack[Script_Call_Depth] DO
  775.                           BEGIN
  776.                              Proc_Param  := Proc_Parameters;
  777.                              Proc_Got    := Proc_Parameter_Got;
  778.                              Proc_Count  := Proc_Parameter_Count;
  779.                              Save_Vars   := NIL;
  780.                           END;
  781.  
  782.                        Copy_Script_Integer_Constant( Script_Integer_1 );
  783.  
  784.                        Script_Buffer_Pos    := SUCC( Script_Buffer_Pos );
  785.  
  786.                        Proc_Parameter_Count := Script_Buffer^[Script_Buffer_Pos];
  787.  
  788.                        IF( Proc_Parameter_Count > 0 ) THEN
  789.                           BEGIN
  790.                              NEW( Proc_Parameters );
  791.                              FOR I := 1 TO Proc_Parameter_Count DO
  792.                                 BEGIN
  793.                                    Script_Buffer_Pos     := SUCC( Script_Buffer_Pos );
  794.                                    Proc_Parameters^[I] :=
  795.                                       Script_Buffer^[Script_Buffer_Pos];
  796.                                 END;
  797.                           END
  798.                        ELSE
  799.                           Proc_Parameters := NIL;
  800.  
  801.                        Script_Call_Stack[Script_Call_Depth].Return_Addr :=
  802.                           Script_Buffer_Pos;
  803.  
  804.                        Proc_Parameter_Got    := 0;
  805.                        Proc_Parameter_Count  := 0;
  806.  
  807.                        Script_Buffer_Pos     := PRED( Script_Integer_1 );
  808.                        Command               := Null_Command;
  809.  
  810.                     END;
  811.                     GOTO LEndCase;
  812.  
  813.       LGoToSy     : Copy_Script_Integer_Constant( Script_Integer_1 );
  814.                     GOTO LEndCase;
  815.  
  816.       LWaitStrSy  : Get_WaitString;
  817.                     GOTO LEndCase;
  818.  
  819.       LCaptureSy  : BEGIN
  820.                        Copy_Script_String( Script_String   , IBogus );
  821.                        Copy_Script_String( Script_String_2 , IBogus );
  822.                     END;
  823.                     GOTO LEndCase;
  824.  
  825.       LWhenSy     : BEGIN
  826.                        Copy_Script_String( Script_When_Text       , IBogus );
  827.                        Copy_Script_String( Script_When_Reply_Text , IBogus );
  828.                        When_Mode := ( LENGTH( Script_When_Text ) > 0 );
  829.                        Command   := Null_Command;
  830.                     END;
  831.                     GOTO LEndCase;
  832.  
  833.       LInputSy    : BEGIN
  834.                        Copy_Script_String( Script_String , IBogus );
  835.                        Copy_Script_String( Script_String_2 , Script_Integer_1 );
  836.                     END;
  837.                     GOTO LEndCase;
  838.  
  839.       LReceiveSy :
  840.       LSendSy     : BEGIN
  841.                        Copy_Script_String( Script_String   , IBogus );
  842.                        Copy_Script_String( Script_String_2 , IBogus );
  843.                        Get_Transfer_Protocol;
  844.                     END;
  845.                     GOTO LEndCase;
  846.  
  847.       LCloseSy    : Copy_Script_Integer( Script_Integer_1 , IBogus );
  848.                     GOTO LEndCase;
  849.  
  850.       LOpenSy     : BEGIN
  851.                        Copy_Script_Integer( Script_Integer_1 , IBogus );
  852.                        Copy_Script_String ( Script_String    , IBogus );
  853.                        Copy_Script_Integer( Script_Integer_2 , IBogus );
  854.                     END;
  855.                     GOTO LEndCase;
  856.  
  857.       LReadSy     : BEGIN
  858.                        Copy_Script_Integer( Script_Integer_1 , IBogus );
  859.                        Copy_Script_String ( Script_String    , Script_Integer_2 );
  860.                        Copy_Script_Integer( Script_Integer_3 , IBogus );
  861.                     END;
  862.                     GOTO LEndCase;
  863.  
  864.       LReadLnSy   :
  865.       LWriteSy    :
  866.       LWriteLnSy  : BEGIN
  867.                       Copy_Script_Integer( Script_Integer_1 , IBogus );
  868.                       Copy_Script_String ( Script_String , Script_Integer_2 );
  869.                    END;
  870.                    GOTO LEndCase;
  871.  
  872.       LWhereXYSy  : BEGIN
  873.                        Copy_Script_Integer( IBogus , Script_Integer_1 );
  874.                        Copy_Script_Integer( IBogus , Script_Integer_2 );
  875.                     END;
  876.                     GOTO LEndCase;
  877.  
  878.       LWaitCountSy: BEGIN
  879.                        Copy_Script_Integer( Script_Wait_Check_Length , IBogus );
  880.                        Script_Wait_Char_Count := 0;
  881.                        Script_Wait_Time       := Script_Default_Wait_Time;
  882.                        Fix_Wait_Time;
  883.                     END;
  884.                     GOTO LEndCase;
  885.  
  886.       LWaitQuietSy: BEGIN
  887.                        Copy_Script_Integer( Script_Integer_1 , IBogus );
  888.                        IF ( Script_Integer_1 > 0 ) THEN
  889.                           BEGIN
  890.                              Script_WaitQuiet_Time := Script_Integer_1;
  891.                              Script_WaitQuiet_Time := Script_WaitQuiet_Time * 10.0;
  892.                              Script_Wait_Start     := TimeOfDayH;
  893.                              Really_Wait_String    := TRUE;
  894.                              WaitQuiet_Mode        := TRUE;
  895.                           END;
  896.                        Command := Null_Command;
  897.                     END;
  898.                     GOTO LEndCase;
  899.  
  900.       LWaitTimeSy : BEGIN
  901.                        Copy_Script_Integer( Script_Integer_1 , IBogus );
  902.                        Script_Default_Wait_Time := Script_Integer_1;
  903.                        Command := Null_Command;
  904.                     END;
  905.                     GOTO LEndCase;
  906.  
  907.       LWaitListSy : Get_WaitList;
  908.                     GOTO LEndCase;
  909.  
  910.       LWhenDropSy : BEGIN
  911.                        Copy_Script_String( Script_When_Drop_Text , IBogus );
  912.                        When_Drop_Mode := ( LENGTH( Script_When_Drop_Text ) > 0 );
  913.                        Command        := Null_Command;
  914.                     END;
  915.                     GOTO LEndCase;
  916.  
  917.       LZapVarSy   : BEGIN
  918.                        Copy_Script_Integer( Script_Integer_1 , IBogus );
  919.                        Copy_Script_Integer( Script_Integer_2 , IBogus );
  920.                     END;
  921.                     GOTO LEndCase;
  922.  
  923.       LMenuSy     : Get_Menu;
  924.                     GOTO LEndCase;
  925.  
  926.       LGetVarSy   : BEGIN
  927.                        Copy_Script_String ( Script_String    , Script_Integer_1 );
  928.                        Copy_Script_String ( Script_String_2  , Script_Integer_2 );
  929.                        Copy_Script_String ( Script_String_3  , Script_Integer_3 );
  930.                        I := Locate_Var( Script_Variables,
  931.                                         Script_Variable_Count,
  932.                                         Script_String,
  933.                                         Script_Variables^[Script_Integer_2].Var_Value^,
  934.                                         Script_Variables^[Script_Integer_3].Var_Value^ );
  935.                        IF ( ( I = 0 ) AND ( Script_Stack_Depth > 0 ) ) THEN
  936.                           I := Locate_Var( Prev_Script_Variables,
  937.                                            Script_Stack_Position[Script_Stack_Depth].Vars_Count,
  938.                                            Script_String,
  939.                                            Script_Variables^[Script_Integer_2].Var_Value^,
  940.                                            Script_Variables^[Script_Integer_3].Var_Value^ );
  941.                        Command := Null_Command;
  942.                     END;
  943.                     GOTO LEndCase;
  944.  
  945.       LSetVarSy   : BEGIN
  946.                        Copy_Script_String ( Script_String    , Script_Integer_1 );
  947.                        Copy_Script_String ( Script_String_4  , Script_Integer_4 );
  948.                        VPtrs := Script_Variables;
  949.                        I     := Locate_Var( Script_Variables,
  950.                                             Script_Variable_Count,
  951.                                             Script_String,
  952.                                             Script_String_2,
  953.                                             Script_String_3 );
  954.                        IF ( ( I = 0 ) AND ( Script_Stack_Depth > 0 ) ) THEN
  955.                           BEGIN
  956.                              VPtrs := Prev_Script_Variables;
  957.                              I     := Locate_Var( Prev_Script_Variables,
  958.                                                   Script_Stack_Position[Script_Stack_Depth].Vars_Count,
  959.                                                   Script_String,
  960.                                                   Script_String_2,
  961.                                                   Script_String_3 );
  962.                           END;
  963.                        IF ( I > 0 ) THEN
  964.                           BEGIN
  965.                              IF ( Script_String_2 = 'INTEGER' ) THEN
  966.                                 BEGIN
  967.                                    Script_String_4 := LTrim( Trim( Script_String_4 ) );
  968.                                    VAL( Script_String_4, IVal, L );
  969.                                    IF ( L = 0 ) THEN
  970.                                       BEGIN
  971.                                          Script_String_4[0] := CHR( 2 );
  972.                                          MOVE( IVal, Script_String_4[1], 2 );
  973.                                       END
  974.                                    ELSE
  975.                                       Script_String_4 := #0 + #0;
  976.                                 END;
  977.                              VPtrs^[I].Var_Value^ := Script_String_4;
  978.                           END;
  979.                        Command := Null_Command;
  980.                     END;
  981.                     GOTO LEndCase;
  982.  
  983.       LGetDirSy:    BEGIN
  984.                        Copy_Script_String ( Script_String    , Script_Integer_1 );
  985.                        Copy_Script_String ( Script_String_2  , Script_Integer_2 );
  986.                     END;
  987.                     GOTO LEndCase;
  988.  
  989.       LEndCase : ;
  990. {
  991.    END (* CASE *);
  992. }
  993.  
  994. END   (* Get_Script_Command *);
  995.